home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.003 / stk-3 / stk / 3.1 / STk / Toplevel.stklos < prev    next >
Encoding:
Text File  |  1996-07-29  |  5.7 KB  |  160 lines
  1. ;;;;
  2. ;;;; T o p l e v e l . s t k      --  Toplevel class definition
  3. ;;;;
  4. ;;;; Copyright ⌐ 1993-1996 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
  5. ;;;; 
  6. ;;;; Permission to use, copy, and/or distribute this software and its
  7. ;;;; documentation for any purpose and without fee is hereby granted, provided
  8. ;;;; that both the above copyright notice and this permission notice appear in
  9. ;;;; all copies and derived works.  Fees for distribution or use of this
  10. ;;;; software or derived works may only be charged with express written
  11. ;;;; permission of the copyright holder.  
  12. ;;;; This software is provided ``as is'' without express or implied warranty.
  13. ;;;;
  14. ;;;;           Author: Erick Gallesio [eg@kaolin.unice.fr]
  15. ;;;;    Creation date:    5-Mar-1994 17:19
  16. ;;;; Last file update: 23-Jul-1996 23:44
  17.  
  18. (require "Basics")
  19.  
  20. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  21. ;;;;
  22. ;;;; <Toplevel> class
  23. ;;;;
  24. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  25.  
  26. (define-class <Toplevel> (<Tk-simple-widget> <Tk-sizeable>)
  27.   ((class    :accessor    class
  28.         :init-keyword     :class
  29.         :allocation    :tk-virtual)
  30.    (colormap    :accessor    colormap
  31.         :init-keyword    :colormap
  32.         :allocation    :tk-virtual)
  33.    (screen    :accessor    screen
  34.         :init-keyword    :screen
  35.         :allocation    :tk-virtual)
  36.    (visual    :accessor    visual
  37.         :init-keyword    :visual
  38.         :allocation    :tk-virtual)
  39.    ;;;;
  40.    ;;;; Following slots embody the Tk:wm command options
  41.    ;;;; Note: "Uncommon" slots have not been given an accessor
  42.    ;;;;
  43.    (aspect    :allocation    :virtual
  44.         :init-keyword    :aspect
  45.         :slot-ref    (lambda (o) (Tk:wm 'aspect (slot-ref o 'Eid)))
  46.         :slot-set!    (lambda (o v) 
  47.                   (apply Tk:wm 'aspect (slot-ref o 'Eid) v)))
  48.  
  49.    (client    :allocation    :virtual
  50.         :init-keyword    :client
  51.         :slot-ref    (lambda (o) (Tk:wm 'client (slot-ref o 'Eid)))
  52.         :slot-set!    (lambda (o v) 
  53.                   (Tk:wm 'client (slot-ref o 'Eid) v)))
  54.    (command    :allocation    :virtual
  55.         :init-keyword    :command
  56.         :slot-ref    (lambda (o) (Tk:wm 'command (slot-ref o 'Eid)))
  57.         :slot-set!    (lambda (o v) 
  58.                   (Tk:wm 'command (slot-ref o 'Eid) v)))
  59.    (focus-model    :allocation    :virtual
  60.         :init-keyword    :focus-model
  61.         :slot-ref    (lambda (o) (Tk:wm 'focus (slot-ref o 'Eid)))
  62.         :slot-set!    (lambda (o v)
  63.                   (Tk:wm 'focus (slot-ref o 'Eid) v)))
  64.    (geometry    :accessor    geometry
  65.         :init-keyword     :geometry
  66.         :allocation    :virtual
  67.         :slot-ref    (lambda (o) (Tk:wm 'geometry (slot-ref o 'Eid)))
  68.         :slot-set!    (lambda (o v)
  69.                   (Tk:wm 'geometry (slot-ref o 'Eid) v)))
  70.    (wm-group    :allocation    :virtual
  71.         :init-keyword    :wm-group
  72.         :slot-ref    (lambda (o) (Tk:wm 'group (slot-ref o 'Eid)))
  73.         :slot-set!    (lambda (o v) 
  74.                   (Tk:wm 'group (slot-ref o 'Eid) v)))
  75.    (icon-bitmap    :accessor    icon-bitmap
  76.         :init-keyword    :icon-bitmap
  77.         :allocation    :virtual
  78.         :slot-ref    (lambda (o)   (Tk:wm 'iconbit (slot-ref o 'Eid)))
  79.         :slot-set!    (lambda (o v) (Tk:wm 'iconbit (slot-ref o 'Eid) v)))
  80.    (icon-mask    :init-keyword    :icon-mask
  81.         :allocation    :virtual
  82.         :slot-ref    (lambda (o)   (Tk:wm 'iconma (slot-ref o 'Eid)))
  83.         :slot-set!    (lambda (o v) (Tk:wm 'iconma (slot-ref o 'Eid) v)))
  84.    (icon-name    :accessor    icon-name
  85.         :init-keyword    :icon-name
  86.         :allocation    :virtual
  87.         :slot-ref    (lambda (o)   (Tk:wm 'iconnam (slot-ref o 'Eid)))
  88.         :slot-set!    (lambda (o v) (Tk:wm 'iconnam (slot-ref o 'Eid) v)))
  89.    (icon-window    :init-keyword    :icon-window
  90.         :allocation    :virtual
  91.         :slot-ref    (lambda (o)   (Tk:wm 'iconwin (slot-ref o 'Eid)))
  92.         :slot-set!    (lambda (o v) (Tk:wm 'iconwin (slot-ref o 'Eid) v)))
  93.    (max-size    :accessor    maximum-size
  94.         :init-keyword    :maximum-size
  95.         :allocation    :virtual
  96.         :slot-ref    (lambda (o) (Tk:wm 'max (slot-ref o 'Eid)))
  97.         :slot-set!    (lambda (o v)
  98.                   (apply Tk:wm 'max (slot-ref o 'Eid) v)))
  99.    (min-size    :accessor    minimum-size
  100.         :init-keyword    :minimum-size
  101.         :allocation    :virtual
  102.         :slot-ref    (lambda (o) (Tk:wm 'min (slot-ref o 'Eid)))
  103.         :slot-set!    (lambda (o v)
  104.                   (apply Tk:wm 'min (slot-ref o 'Eid) v)))
  105.    (override    :init-keyword    :override-redirect
  106.         :allocation    :virtual
  107.         :slot-ref    (lambda (o)   (Tk:wm 'over (slot-ref o 'Eid)))
  108.         :slot-set!    (lambda (o v) (Tk:wm 'over (slot-ref o 'Eid) v)))
  109.    (pos-from    :init-keyword    :position-from
  110.         :allocation    :virtual
  111.         :slot-ref    (lambda (o)   (Tk:wm 'pos (slot-ref o 'Eid)))
  112.         :slot-set!    (lambda (o v) (Tk:wm 'pos (slot-ref o 'Eid) v)))
  113.    (protocol    :init-keyword    :protocol
  114.         :allocation    :virtual
  115.         :slot-ref    (lambda (o)   (Tk:wm 'proto (slot-ref o 'Eid)))
  116.         :slot-set!    (lambda (o v) (Tk:wm 'proto (slot-ref o 'Eid) v)))
  117.    (size-from    :init-keyword    :size-from
  118.         :allocation    :virtual
  119.         :slot-ref    (lambda (o)   (Tk:wm 'size (slot-ref o 'Eid)))
  120.         :slot-set!    (lambda (o v) (Tk:wm 'size (slot-ref o 'Eid) v)))
  121.    (title    :accessor    title
  122.         :init-keyword    :title
  123.         :allocation    :virtual
  124.         :slot-ref    (lambda (o)   (Tk:wm 'title (slot-ref o 'Eid)))
  125.         :slot-set!    (lambda (o v) (Tk:wm 'title (slot-ref o 'Eid) v)))
  126.    (transient    :accessor    transient-for
  127.         :init-keyword    :transient-for
  128.         :allocation    :virtual
  129.         :slot-ref       (lambda (o)   (Tk:wm 'trans (slot-ref o 'Eid)))
  130.         :slot-set!      (lambda (o v) (Tk:wm 'trans (slot-ref o 'Eid) v)))))
  131.  
  132.  
  133.  
  134. (define-method tk-constructor ((self <Toplevel>))
  135.   Tk:toplevel)
  136.  
  137. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  138. ;;;;
  139. ;;;; Some methods 
  140. ;;;;
  141. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  142.  
  143. (define-method deiconify ((self <Toplevel>))
  144.   (Tk:wm 'deiconify (slot-ref self 'Eid)))
  145.  
  146. (define-method iconify ((self <Toplevel>))
  147.   (Tk:wm 'iconify (slot-ref self 'Eid)))
  148.  
  149. (define-method toplevel-frame ((self <Toplevel>))
  150.   (Tk:wm 'frame (slot-ref self 'Eid)))
  151.  
  152. (define-method toplevel-state ((self <Toplevel>))
  153.   (Tk:wm 'state (slot-ref self 'Eid)))
  154.  
  155. (define-method withdraw ((self <Toplevel>))
  156.   (Tk:wm 'withdraw (slot-ref self 'Eid)))
  157.  
  158. (provide "Toplevel")
  159.  
  160.